Decorrelation-Based Feature Discovery: Wisconsin
Jose Tamez
2023-09-18
- 1 Effect of UPSTM-Based Decorrelation
on Feature Discovery
- 1.0.1 Loading the libraries
- 1.1 Material and Methods
- 1.2 The Data
- 1.3 Generaring the report
- 1.4 The heatmap of the data
- 1.5 The decorrelation
- 1.6 The heatmap of the decorrelated data
- 1.7 The correlation matrix after decorrelation
- 1.8 U-MAP Visualization of features
- 1.9 Univariate Analysis
- 1.10 Comparing IDeA vs PCA vs EFA
- 1.11 Effect on CAR modeling
1 Effect of UPSTM-Based Decorrelation on Feature Discovery
1.0.1 Loading the libraries
library("FRESA.CAD")
library(readxl)
library(igraph)
library(umap)
library(tsne)
library(entropy)
library(TH.data)
library(psych)
library(whitening)
library("vioplot")
library("rpart")
library(mlbench)
op <- par(no.readonly = TRUE)
pander::panderOptions('digits', 3)
pander::panderOptions('table.split.table', 400)
pander::panderOptions('keep.trailing.zeros',TRUE)1.1 Material and Methods
Source W. Nick Street, Olvi L. Mangasarian and William H. Wolberg (1995). An inductive learning approach to prognostic prediction. In A. Prieditis and S. Russell, editors, Proceedings of the Twelfth International Conference on Machine Learning, pages 522–530, San Francisco, Morgan Kaufmann.
Peter Buehlmann and Torsten Hothorn (2007), Boosting algorithms: regularization, prediction and model fitting. Statistical Science, 22(4), 477–505.
1.2 The Data
wpbc {TH.data}
data("wpbc", package = "TH.data")
table(wpbc[,"status"])
#>
#> N R
#> 151 47
sum(1*(wpbc[,"status"]=="R" & wpbc$time <= 24))
#> [1] 29
wpbc <- subset(wpbc,time > 36 | status=="R" )
summary(wpbc$time)
#> Min. 1st Qu. Median Mean 3rd Qu. Max.
#> 1.00 36.75 60.50 58.79 78.75 125.00
wpbc[,"status"] <- 1*(wpbc[,"status"]=="R")
wpbc <- wpbc[complete.cases(wpbc),]
pander::pander(table(wpbc[,"status"]))| 0 | 1 |
|---|---|
| 91 | 46 |
wpbc$time <- NULL1.2.0.1 Standarize the names for the reporting
studyName <- "Wisconsin"
dataframe <- wpbc
outcome <- "status"
thro <- 0.4
TopVariables <- 10
cexheat = 0.251.3 Generaring the report
1.3.1 Libraries
Some libraries
library(psych)
library(whitening)
library("vioplot")
library("rpart")1.3.2 Data specs
pander::pander(c(rows=nrow(dataframe),col=ncol(dataframe)-1))| rows | col |
|---|---|
| 137 | 32 |
pander::pander(table(dataframe[,outcome]))| 0 | 1 |
|---|---|
| 91 | 46 |
varlist <- colnames(dataframe)
varlist <- varlist[varlist != outcome]
largeSet <- length(varlist) > 1500 1.3.3 Scaling the data
Scaling and removing near zero variance columns and highly co-linear(r>0.99999) columns
### Some global cleaning
sdiszero <- apply(dataframe,2,sd) > 1.0e-16
dataframe <- dataframe[,sdiszero]
varlist <- colnames(dataframe)[colnames(dataframe) != outcome]
tokeep <- c(as.character(correlated_Remove(dataframe,varlist,thr=0.99999)),outcome)
dataframe <- dataframe[,tokeep]
varlist <- colnames(dataframe)
varlist <- varlist[varlist != outcome]
iscontinous <- sapply(apply(dataframe,2,unique),length) >= 5 ## Only variables with enough samples
dataframeScaled <- FRESAScale(dataframe,method="OrderLogit")$scaledData1.4 The heatmap of the data
numsub <- nrow(dataframe)
if (numsub > 1000) numsub <- 1000
if (!largeSet)
{
hm <- heatMaps(data=dataframeScaled[1:numsub,],
Outcome=outcome,
Scale=TRUE,
hCluster = "row",
xlab="Feature",
ylab="Sample",
srtCol=45,
srtRow=45,
cexCol=cexheat,
cexRow=cexheat
)
par(op)
}
1.4.0.1 Correlation Matrix of the Data
The heat map of the data
if (!largeSet)
{
par(cex=0.6,cex.main=0.85,cex.axis=0.7)
#cormat <- Rfast::cora(as.matrix(dataframe[,varlist]),large=TRUE)
cormat <- cor(dataframe[,varlist],method="pearson")
cormat[is.na(cormat)] <- 0
gplots::heatmap.2(abs(cormat),
trace = "none",
# scale = "row",
mar = c(5,5),
col=rev(heat.colors(5)),
main = "Original Correlation",
cexRow = cexheat,
cexCol = cexheat,
srtCol=45,
srtRow=45,
key.title=NA,
key.xlab="|Pearson Correlation|",
xlab="Feature", ylab="Feature")
diag(cormat) <- 0
print(max(abs(cormat)))
}
[1]
0.9961379
1.5 The decorrelation
DEdataframe <- IDeA(dataframe,verbose=TRUE,thr=thro)
#>
#> Included: 32 , Uni p: 0.0233331 , Uncorrelated Base: 4 , Outcome-Driven Size: 0 , Base Size: 4
#>
#>
1 <R=0.996,thr=0.900,N= 9>, Top: 2( 4 )[ 1 : 2 Fa= 2 : 0.900 ]( 2 , 6 , 0 ),<|>Tot Used: 8 , Added: 6 , Zero Std: 0 , Max Cor: 0.922
#>
2 <R=0.922,thr=0.900,N= 9>, Top: 1( 1 )[ 1 : 1 Fa= 3 : 0.900 ]( 1 , 1 , 2 ),<|>Tot Used: 8 , Added: 1 , Zero Std: 0 , Max Cor: 0.895
#>
3 <R=0.895,thr=0.750,N= 22>, Top: 7( 4 )[ 1 : 7 Fa= 9 : 0.750 ]( 7 , 11 , 3 ),<|>Tot Used: 22 , Added: 11 , Zero Std: 0 , Max Cor: 0.952
#>
4 <R=0.952,thr=0.900,N= 2>, Top: 1( 1 )[ 1 : 1 Fa= 9 : 0.900 ]( 1 , 1 , 9 ),<|>Tot Used: 22 , Added: 1 , Zero Std: 0 , Max Cor: 0.810
#>
5 <R=0.810,thr=0.750,N= 4>, Top: 2( 1 )[ 1 : 2 Fa= 10 : 0.750 ]( 2 , 2 , 9 ),<|>Tot Used: 24 , Added: 2 , Zero Std: 0 , Max Cor: 0.744
#>
6 <R=0.744,thr=0.600,N= 15>, Top: 4( 1 )[ 1 : 4 Fa= 12 : 0.600 ]( 4 , 5 , 10 ),<|>Tot Used: 24 , Added: 5 , Zero Std: 0 , Max Cor: 0.826
#>
7 <R=0.826,thr=0.750,N= 2>, Top: 1( 1 )[ 1 : 1 Fa= 12 : 0.750 ]( 1 , 1 , 12 ),<|>Tot Used: 24 , Added: 1 , Zero Std: 0 , Max Cor: 0.730
#>
8 <R=0.730,thr=0.600,N= 9>, Top: 3( 1 )[ 1 : 3 Fa= 14 : 0.600 ]( 3 , 4 , 12 ),<|>Tot Used: 26 , Added: 4 , Zero Std: 0 , Max Cor: 0.727
#>
9 <R=0.727,thr=0.600,N= 9>, Top: 2( 1 )[ 1 : 2 Fa= 15 : 0.600 ]( 2 , 2 , 14 ),<|>Tot Used: 28 , Added: 2 , Zero Std: 0 , Max Cor: 0.591
#>
10 <R=0.591,thr=0.450,N= 23>, Top: 8( 3 )[ 1 : 8 Fa= 17 : 0.450 ]( 7 , 12 , 15 ),<|>Tot Used: 30 , Added: 12 , Zero Std: 0 , Max Cor: 0.651
#>
11 <R=0.651,thr=0.600,N= 4>, Top: 2( 1 )[ 1 : 2 Fa= 17 : 0.600 ]( 2 , 2 , 17 ),<|>Tot Used: 30 , Added: 2 , Zero Std: 0 , Max Cor: 0.626
#>
12 <R=0.626,thr=0.600,N= 4>, Top: 1( 1 )[ 1 : 1 Fa= 17 : 0.600 ]( 1 , 1 , 17 ),<|>Tot Used: 30 , Added: 1 , Zero Std: 0 , Max Cor: 0.670
#>
13 <R=0.670,thr=0.600,N= 4>, Top: 1( 1 )[ 1 : 1 Fa= 17 : 0.600 ]( 1 , 1 , 17 ),<|>Tot Used: 30 , Added: 1 , Zero Std: 0 , Max Cor: 0.597
#>
14 <R=0.597,thr=0.450,N= 13>, Top: 5( 1 )[ 1 : 5 Fa= 18 : 0.450 ]( 5 , 7 , 17 ),<|>Tot Used: 31 , Added: 7 , Zero Std: 0 , Max Cor: 0.526
#>
15 <R=0.526,thr=0.450,N= 13>, Top: 3( 1 )[ 1 : 3 Fa= 19 : 0.450 ]( 3 , 5 , 18 ),<|>Tot Used: 31 , Added: 5 , Zero Std: 0 , Max Cor: 0.624
#>
16 <R=0.624,thr=0.600,N= 2>, Top: 1( 1 )[ 1 : 1 Fa= 20 : 0.600 ]( 1 , 1 , 19 ),<|>Tot Used: 31 , Added: 1 , Zero Std: 0 , Max Cor: 0.476
#>
17 <R=0.476,thr=0.450,N= 2>, Top: 1( 1 )[ 1 : 1 Fa= 21 : 0.450 ]( 1 , 1 , 20 ),<|>Tot Used: 32 , Added: 1 , Zero Std: 0 , Max Cor: 0.444
#>
18 <R=0.444,thr=0.400,N= 16>, Top: 6( 3 )[ 1 : 6 Fa= 22 : 0.400 ]( 6 , 9 , 21 ),<|>Tot Used: 32 , Added: 9 , Zero Std: 0 , Max Cor: 0.562
#>
19 <R=0.562,thr=0.450,N= 2>, Top: 1( 1 )[ 1 : 1 Fa= 23 : 0.450 ]( 1 , 1 , 22 ),<|>Tot Used: 32 , Added: 1 , Zero Std: 0 , Max Cor: 0.435
#>
20 <R=0.435,thr=0.400,N= 7>, Top: 3( 1 )[ 1 : 3 Fa= 23 : 0.400 ]( 3 , 4 , 23 ),<|>Tot Used: 32 , Added: 4 , Zero Std: 0 , Max Cor: 0.394
#>
21 <R=0.394,thr=0.400,N= 7>
#>
[ 21 ], 0.3936457 Decor Dimension: 32 Nused: 32 . Cor to Base: 28 , ABase: 4 , Outcome Base: 0
#>
varlistc <- colnames(DEdataframe)[colnames(DEdataframe) != outcome]
pander::pander(sum(apply(dataframe[,varlist],2,var)))515156
pander::pander(sum(apply(DEdataframe[,varlistc],2,var)))3970
pander::pander(entropy(discretize(unlist(dataframe[,varlist]), 256)))1.39
pander::pander(entropy(discretize(unlist(DEdataframe[,varlistc]), 256)))1.45
1.5.1 The decorrelation matrix
if (!largeSet)
{
par(cex=0.6,cex.main=0.85,cex.axis=0.7)
UPSTM <- attr(DEdataframe,"UPSTM")
gplots::heatmap.2(1.0*(abs(UPSTM)>0),
trace = "none",
mar = c(5,5),
col=rev(heat.colors(5)),
main = "Decorrelation matrix",
cexRow = cexheat,
cexCol = cexheat,
srtCol=45,
srtRow=45,
key.title=NA,
key.xlab="|Beta|>0",
xlab="Output Feature", ylab="Input Feature")
par(op)
}
1.6 The heatmap of the decorrelated data
if (!largeSet)
{
hm <- heatMaps(data=DEdataframe[1:numsub,],
Outcome=outcome,
Scale=TRUE,
hCluster = "row",
cexRow = cexheat,
cexCol = cexheat,
srtCol=45,
srtRow=45,
xlab="Feature",
ylab="Sample")
par(op)
}
1.7 The correlation matrix after decorrelation
if (!largeSet)
{
cormat <- cor(DEdataframe[,varlistc],method="pearson")
cormat[is.na(cormat)] <- 0
gplots::heatmap.2(abs(cormat),
trace = "none",
mar = c(5,5),
col=rev(heat.colors(5)),
main = "Correlation after IDeA",
cexRow = cexheat,
cexCol = cexheat,
srtCol=45,
srtRow=45,
key.title=NA,
key.xlab="|Pearson Correlation|",
xlab="Feature", ylab="Feature")
par(op)
diag(cormat) <- 0
print(max(abs(cormat)))
}
[1]
0.3936457
1.8 U-MAP Visualization of features
1.8.1 The UMAP based on LASSO on Raw Data
if (nrow(dataframe) < 1000)
{
classes <- unique(dataframe[1:numsub,outcome])
raincolors <- rainbow(length(classes))
names(raincolors) <- classes
datasetframe.umap = umap(scale(dataframe[1:numsub,varlist]),n_components=2)
plot(datasetframe.umap$layout,xlab="U1",ylab="U2",main="UMAP: Original",t='n')
text(datasetframe.umap$layout,labels=dataframe[1:numsub,outcome],col=raincolors[dataframe[1:numsub,outcome]+1])
}
1.8.2 The decorralted UMAP
if (nrow(dataframe) < 1000)
{
datasetframe.umap = umap(scale(DEdataframe[1:numsub,varlistc]),n_components=2)
plot(datasetframe.umap$layout,xlab="U1",ylab="U2",main="UMAP: After IDeA",t='n')
text(datasetframe.umap$layout,labels=DEdataframe[1:numsub,outcome],col=raincolors[DEdataframe[1:numsub,outcome]+1])
}
1.9 Univariate Analysis
1.9.1 Univariate
univarRAW <- uniRankVar(varlist,
paste(outcome,"~1"),
outcome,
dataframe,
rankingTest="AUC")
univarDe <- uniRankVar(varlistc,
paste(outcome,"~1"),
outcome,
DEdataframe,
rankingTest="AUC",
)
1.9.2 Final Table
univariate_columns <- c("caseMean","caseStd","controlMean","controlStd","controlKSP","ROCAUC")
##top variables
topvar <- c(1:length(varlist)) <= TopVariables
tableRaw <- univarRAW$orderframe[topvar,univariate_columns]
pander::pander(tableRaw)| caseMean | caseStd | controlMean | controlStd | controlKSP | ROCAUC | |
|---|---|---|---|---|---|---|
| tsize | 3.47 | 2.03 | 2.64 | 1.86 | 1.11e-03 | 0.666 |
| pnodes | 4.87 | 6.02 | 2.63 | 5.21 | 6.25e-09 | 0.650 |
| worst_radius | 22.67 | 4.70 | 20.35 | 4.08 | 3.68e-01 | 0.647 |
| worst_perimeter | 151.33 | 32.42 | 135.34 | 26.85 | 5.71e-01 | 0.645 |
| mean_area | 1081.98 | 397.26 | 888.40 | 310.85 | 1.26e-01 | 0.645 |
| worst_area | 1635.77 | 703.15 | 1317.95 | 550.94 | 2.72e-01 | 0.643 |
| mean_perimeter | 121.10 | 22.91 | 110.02 | 19.19 | 4.72e-01 | 0.641 |
| mean_radius | 18.33 | 3.37 | 16.70 | 2.91 | 3.12e-01 | 0.639 |
| SE_perimeter | 4.73 | 2.21 | 3.81 | 1.80 | 6.37e-02 | 0.634 |
| SE_area | 81.97 | 53.36 | 61.22 | 37.72 | 6.46e-02 | 0.632 |
topLAvar <- univarDe$orderframe$Name[str_detect(univarDe$orderframe$Name,"La_")]
topLAvar <- unique(c(univarDe$orderframe$Name[topvar],topLAvar[1:as.integer(TopVariables/2)]))
finalTable <- univarDe$orderframe[topLAvar,univariate_columns]
pander::pander(finalTable)| caseMean | caseStd | controlMean | controlStd | controlKSP | ROCAUC | |
|---|---|---|---|---|---|---|
| tsize | 3.4717 | 2.02985 | 2.6385 | 1.85507 | 0.001110 | 0.666 |
| mean_radius | 18.3309 | 3.36557 | 16.6995 | 2.91309 | 0.312037 | 0.639 |
| La_worst_area | 76.8794 | 31.77365 | 91.2827 | 47.79094 | 0.040138 | 0.617 |
| La_mean_perimeter | -5.8279 | 0.63127 | -6.0958 | 0.73758 | 0.080004 | 0.604 |
| La_mean_symmetry | 0.0648 | 0.02261 | 0.0719 | 0.02497 | 0.154781 | 0.602 |
| La_SE_area | 28.3318 | 10.03311 | 29.9021 | 7.75179 | 0.876781 | 0.592 |
| La_worst_compactness | -0.2453 | 0.06619 | -0.2210 | 0.07815 | 0.232035 | 0.581 |
| La_worst_concavepoints | 0.0379 | 0.01715 | 0.0421 | 0.01767 | 0.327131 | 0.580 |
| La_worst_concavity | 0.2687 | 0.06233 | 0.2543 | 0.06245 | 0.992950 | 0.571 |
| La_SE_symmetry | -0.0108 | 0.00671 | -0.0116 | 0.00839 | 0.000176 | 0.563 |
dc <- getLatentCoefficients(DEdataframe)
fscores <- attr(DEdataframe,"fscore")
pander::pander(c(mean=mean(sapply(dc,length)),total=length(dc),fraction=length(dc)/(ncol(dataframe)-1)))| mean | total | fraction |
|---|---|---|
| 5.21 | 28 | 0.875 |
theCharformulas <- attr(dc,"LatentCharFormulas")
finalTable <- rbind(finalTable,tableRaw[topvar[!(topvar %in% topLAvar)],univariate_columns])
orgnamez <- rownames(finalTable)
orgnamez <- str_remove_all(orgnamez,"La_")
finalTable$RAWAUC <- univarRAW$orderframe[orgnamez,"ROCAUC"]
finalTable$DecorFormula <- theCharformulas[rownames(finalTable)]
finalTable$fscores <- fscores[rownames(finalTable)]
Final_Columns <- c("DecorFormula","caseMean","caseStd","controlMean","controlStd","controlKSP","ROCAUC","RAWAUC","fscores")
finalTable <- finalTable[order(-finalTable$ROCAUC),]
pander::pander(finalTable[,Final_Columns])| DecorFormula | caseMean | caseStd | controlMean | controlStd | controlKSP | ROCAUC | RAWAUC | fscores | |
|---|---|---|---|---|---|---|---|---|---|
| tsize | NA | 3.4717 | 2.03e+00 | 2.6385 | 1.86e+00 | 1.11e-03 | 0.666 | 0.666 | 1 |
| tsize1 | NA | 3.4717 | 2.03e+00 | 2.6385 | 1.86e+00 | 1.11e-03 | 0.666 | NA | NA |
| pnodes | NA | 4.8696 | 6.02e+00 | 2.6264 | 5.21e+00 | 6.25e-09 | 0.650 | 0.650 | NA |
| worst_radius | NA | 22.6704 | 4.70e+00 | 20.3456 | 4.08e+00 | 3.68e-01 | 0.647 | 0.647 | NA |
| worst_perimeter | NA | 151.3326 | 3.24e+01 | 135.3397 | 2.68e+01 | 5.71e-01 | 0.645 | 0.645 | NA |
| mean_area | NA | 1081.9804 | 3.97e+02 | 888.4000 | 3.11e+02 | 1.26e-01 | 0.645 | 0.645 | NA |
| worst_area | NA | 1635.7674 | 7.03e+02 | 1317.9462 | 5.51e+02 | 2.72e-01 | 0.643 | 0.643 | NA |
| mean_perimeter | NA | 121.0952 | 2.29e+01 | 110.0223 | 1.92e+01 | 4.72e-01 | 0.641 | 0.641 | NA |
| mean_radius | NA | 18.3309 | 3.37e+00 | 16.6995 | 2.91e+00 | 3.12e-01 | 0.639 | 0.639 | 11 |
| mean_radius1 | NA | 18.3309 | 3.37e+00 | 16.6995 | 2.91e+00 | 3.12e-01 | 0.639 | NA | NA |
| SE_perimeter | NA | 4.7350 | 2.21e+00 | 3.8107 | 1.80e+00 | 6.37e-02 | 0.634 | 0.634 | NA |
| SE_area | NA | 81.9654 | 5.34e+01 | 61.2238 | 3.77e+01 | 6.46e-02 | 0.632 | 0.632 | NA |
| La_worst_area | + (1.56e+02)mean_radius - (1.353)mean_area + (4.52e+02)SE_radius - (3.667)SE_area - (1.30e+02)worst_radius + worst_area | 76.8794 | 3.18e+01 | 91.2827 | 4.78e+01 | 4.01e-02 | 0.617 | 0.643 | -5 |
| La_mean_perimeter | - (6.657)mean_radius + mean_perimeter - (33.734)mean_compactness + (5.813)SE_radius - (0.844)SE_perimeter | -5.8279 | 6.31e-01 | -6.0958 | 7.38e-01 | 8.00e-02 | 0.604 | 0.641 | -3 |
| La_mean_symmetry | - (1.194)mean_smoothness + mean_symmetry | 0.0648 | 2.26e-02 | 0.0719 | 2.50e-02 | 1.55e-01 | 0.602 | 0.580 | 2 |
| La_SE_area | + (12.040)mean_radius - (0.094)mean_area - (1.17e+02)SE_radius + SE_area - (4.162)worst_radius | 28.3318 | 1.00e+01 | 29.9021 | 7.75e+00 | 8.77e-01 | 0.592 | 0.632 | -4 |
| La_worst_compactness | + (0.031)mean_radius - (3.537)mean_smoothness - (1.315)mean_compactness + (0.097)SE_radius + (11.923)SE_smoothness - (4.336)SE_compactness - (0.028)worst_radius + worst_compactness | -0.2453 | 6.62e-02 | -0.2210 | 7.82e-02 | 2.32e-01 | 0.581 | 0.538 | 1 |
| La_worst_concavepoints | - (1.73e-03)mean_radius + (1.702)mean_smoothness + (0.161)mean_compactness - (1.087)mean_concavepoints + (0.034)SE_radius + (5.979)SE_smoothness - (4.867)SE_concavepoints - (1.246)worst_smoothness - (0.061)worst_compactness + worst_concavepoints | 0.0379 | 1.71e-02 | 0.0421 | 1.77e-02 | 3.27e-01 | 0.580 | 0.515 | -4 |
| La_worst_concavity | + (0.014)mean_radius - (0.862)mean_smoothness + (1.655)mean_compactness - (2.034)mean_concavity - (0.680)worst_compactness + worst_concavity | 0.2687 | 6.23e-02 | 0.2543 | 6.25e-02 | 9.93e-01 | 0.571 | 0.492 | -2 |
| La_SE_symmetry | + (0.039)mean_smoothness + (0.091)mean_compactness - (0.233)mean_symmetry + (0.808)SE_smoothness - (0.294)SE_compactness + SE_symmetry | -0.0108 | 6.71e-03 | -0.0116 | 8.39e-03 | 1.76e-04 | 0.563 | 0.504 | -1 |
1.10 Comparing IDeA vs PCA vs EFA
1.10.1 PCA
featuresnames <- colnames(dataframe)[colnames(dataframe) != outcome]
pc <- prcomp(dataframe[,iscontinous],center = TRUE,scale. = TRUE) #principal components
predPCA <- predict(pc,dataframe[,iscontinous])
PCAdataframe <- as.data.frame(cbind(predPCA,dataframe[,!iscontinous]))
colnames(PCAdataframe) <- c(colnames(predPCA),colnames(dataframe)[!iscontinous])
#plot(PCAdataframe[,colnames(PCAdataframe)!=outcome],col=dataframe[,outcome],cex=0.65,cex.lab=0.5,cex.axis=0.75,cex.sub=0.5,cex.main=0.75)
#pander::pander(pc$rotation)
PCACor <- cor(PCAdataframe[,colnames(PCAdataframe) != outcome])
gplots::heatmap.2(abs(PCACor),
trace = "none",
# scale = "row",
mar = c(5,5),
col=rev(heat.colors(5)),
main = "PCA Correlation",
cexRow = 0.5,
cexCol = 0.5,
srtCol=45,
srtRow= -45,
key.title=NA,
key.xlab="Pearson Correlation",
xlab="Feature", ylab="Feature")
1.10.2 EFA
EFAdataframe <- dataframeScaled
if (length(iscontinous) < 2000)
{
topred <- min(length(iscontinous),nrow(dataframeScaled),ncol(predPCA)/2)
if (topred < 2) topred <- 2
uls <- fa(dataframeScaled[,iscontinous],nfactors=topred,rotate="varimax",warnings=FALSE) # EFA analysis
predEFA <- predict(uls,dataframeScaled[,iscontinous])
EFAdataframe <- as.data.frame(cbind(predEFA,dataframeScaled[,!iscontinous]))
colnames(EFAdataframe) <- c(colnames(predEFA),colnames(dataframeScaled)[!iscontinous])
EFACor <- cor(EFAdataframe[,colnames(EFAdataframe) != outcome])
gplots::heatmap.2(abs(EFACor),
trace = "none",
# scale = "row",
mar = c(5,5),
col=rev(heat.colors(5)),
main = "EFA Correlation",
cexRow = 0.5,
cexCol = 0.5,
srtCol=45,
srtRow= -45,
key.title=NA,
key.xlab="Pearson Correlation",
xlab="Feature", ylab="Feature")
}
1.11 Effect on CAR modeling
par(op)
par(xpd = TRUE)
dataframe[,outcome] <- factor(dataframe[,outcome])
rawmodel <- rpart(paste(outcome,"~."),dataframe,control=rpart.control(maxdepth=3))
pr <- predict(rawmodel,dataframe,type = "class")
ptab <- list(er="Error",detail=matrix(nrow=6,ncol=1))
if (length(unique(pr))>1)
{
plot(rawmodel,main="Raw",branch=0.5,uniform = TRUE,compress = TRUE,margin=0.1)
text(rawmodel, use.n = TRUE,cex=0.75)
ptab <- epiR::epi.tests(table(pr==0,dataframe[,outcome]==0))
}
pander::pander(table(dataframe[,outcome],pr))| 0 | 1 | |
|---|---|---|
| 0 | 68 | 23 |
| 1 | 9 | 37 |
pander::pander(ptab$detail[c(5,3,4,6),])| statistic | est | lower | upper | |
|---|---|---|---|---|
| 5 | diag.ac | 0.766 | 0.687 | 0.834 |
| 3 | se | 0.804 | 0.661 | 0.906 |
| 4 | sp | 0.747 | 0.645 | 0.833 |
| 6 | diag.or | 12.155 | 5.100 | 28.966 |
par(op)
par(xpd = TRUE)
DEdataframe[,outcome] <- factor(DEdataframe[,outcome])
IDeAmodel <- rpart(paste(outcome,"~."),DEdataframe,control=rpart.control(maxdepth=3))
pr <- predict(IDeAmodel,DEdataframe,type = "class")
ptab <- list(er="Error",detail=matrix(nrow=6,ncol=1))
if (length(unique(pr))>1)
{
plot(IDeAmodel,main="IDeA",branch=0.5,uniform = TRUE,compress = TRUE,margin=0.1)
text(IDeAmodel, use.n = TRUE,cex=0.75)
ptab <- epiR::epi.tests(table(pr==0,DEdataframe[,outcome]==0))
}
pander::pander(table(DEdataframe[,outcome],pr))| 0 | 1 | |
|---|---|---|
| 0 | 79 | 12 |
| 1 | 20 | 26 |
pander::pander(ptab$detail[c(5,3,4,6),])| statistic | est | lower | upper | |
|---|---|---|---|---|
| 5 | diag.ac | 0.766 | 0.687 | 0.834 |
| 3 | se | 0.565 | 0.411 | 0.711 |
| 4 | sp | 0.868 | 0.781 | 0.930 |
| 6 | diag.or | 8.558 | 3.688 | 19.859 |
par(op)
par(xpd = TRUE)
PCAdataframe[,outcome] <- factor(PCAdataframe[,outcome])
PCAmodel <- rpart(paste(outcome,"~."),PCAdataframe,control=rpart.control(maxdepth=3))
pr <- predict(PCAmodel,PCAdataframe,type = "class")
ptab <- list(er="Error",detail=matrix(nrow=6,ncol=1))
if (length(unique(pr))>1)
{
plot(PCAmodel,main="PCA",branch=0.5,uniform = TRUE,compress = TRUE,margin=0.1)
text(PCAmodel, use.n = TRUE,cex=0.75)
ptab <- epiR::epi.tests(table(pr==0,PCAdataframe[,outcome]==0))
}
pander::pander(table(PCAdataframe[,outcome],pr))| 0 | 1 | |
|---|---|---|
| 0 | 86 | 5 |
| 1 | 27 | 19 |
pander::pander(ptab$detail[c(5,3,4,6),])| statistic | est | lower | upper | |
|---|---|---|---|---|
| 5 | diag.ac | 0.766 | 0.687 | 0.834 |
| 3 | se | 0.413 | 0.270 | 0.568 |
| 4 | sp | 0.945 | 0.876 | 0.982 |
| 6 | diag.or | 12.104 | 4.128 | 35.493 |
par(op)1.11.1 EFA
EFAdataframe[,outcome] <- factor(EFAdataframe[,outcome])
EFAmodel <- rpart(paste(outcome,"~."),EFAdataframe,control=rpart.control(maxdepth=3))
pr <- predict(EFAmodel,EFAdataframe,type = "class")
ptab <- list(er="Error",detail=matrix(nrow=6,ncol=1))
if (length(unique(pr))>1)
{
plot(EFAmodel,main="EFA",branch=0.5,uniform = TRUE,compress = TRUE,margin=0.1)
text(EFAmodel, use.n = TRUE,cex=0.75)
ptab <- epiR::epi.tests(table(pr==0,EFAdataframe[,outcome]==0))
}
pander::pander(table(EFAdataframe[,outcome],pr))| 0 | 1 | |
|---|---|---|
| 0 | 90 | 1 |
| 1 | 38 | 8 |
pander::pander(ptab$detail[c(5,3,4,6),])| statistic | est | lower | upper | |
|---|---|---|---|---|
| 5 | diag.ac | 0.715 | 0.6320 | 0.789 |
| 3 | se | 0.174 | 0.0782 | 0.314 |
| 4 | sp | 0.989 | 0.9403 | 1.000 |
| 6 | diag.or | 18.947 | 2.2899 | 156.776 |
par(op)